home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 2.img / STEDIT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-11-10  |  33.2 KB  |  1,302 lines
  1. 10  REM *** DESIGNED BY DALE BENZER/PROGRAMMED BY PETER SCHLAIFER ******
  2. 20  REM ***** COPYRIGHT 1984 ****** ALL RIGHTS RESERVED *******
  3. 25  REM ******* REVISED 8/29/84 ****** PS ******
  4. 30  CLS
  5. 40   WIDTH 80
  6. 50    KEY OFF
  7. 60     LOCATE 1,27
  8. 70      COLOR 0,7
  9. 80       PRINT "  >>> STATLIB EDITOR <<<  "
  10. 90        COLOR 7,0
  11. 100         COLOR 0,7
  12. 110          COLOR 7,0
  13. 120           LOCATE 3,34
  14. 130            PRINT "VERSION 1.2"
  15. 140             COLOR 0,7
  16. 150              X$ = CHR$( 186 )
  17. 160  LOCATE 5,10,0
  18. 170   PRINT CHR$( 201 ) + STRING$( 59,205 ) + CHR$( 187 )
  19. 180    LOCATE 19,10
  20. 190     PRINT CHR$( 200 ) + STRING$( 59,205 ) + CHR$( 188 )
  21. 200      FOR W = 6 TO 18
  22. 210       LOCATE W,10
  23. 220        PRINT X$
  24. 230         LOCATE W,70
  25. 240          PRINT X$
  26. 250           NEXT
  27. 260            COLOR 0,15
  28. 270             COLOR 7,0
  29. 280              LOCATE 7,29
  30. 290               PRINT "DESIGNED BY DALE BENZER"
  31. 300  LOCATE 9,26
  32. 310   PRINT "PROGRAMMED BY PETER SCHLAIFER"
  33. 320    LOCATE 11,37
  34. 330     PRINT "FOR"
  35. 340      LOCATE 13,25
  36. 350       PRINT "THE PC DISK LIBRARY OF SOFTWARE"
  37. 360        LOCATE 15,32
  38. 370         PRINT "COPYRIGHT 1984 "
  39. 380          LOCATE 17,26
  40. 390           PRINT "ZIFF-DAVIS PUBLISHING CO., INC."
  41. 400  LOCATE 22,26
  42. 410   PRINT "PRESS ANY KEY TO CONTINUE"
  43. 420  A$ = INKEY$
  44. 430   IF A$ = "" THEN 420
  45. 1000    LOCATE 22,26,1
  46. 1010     CLEAR ,,2500
  47. 1020      PRINT "INITIALIZING STATLIB EDITOR..."
  48. 1030       GOSUB 1080
  49. 1060          GOSUB 3130
  50. 1070           GOTO 5860
  51. 1080  KEY OFF
  52. 1085  DEFINT B-Z:DEFSNG A,U,V
  53. 1086  LOCATE,,0
  54. 1090   FOR J = 1 TO 10
  55. 1100    KEY J,""
  56. 1110     NEXT
  57. 1120      CR$ = CHR$( 13 )
  58. 1130       ESC$ = CHR$( 27 )
  59. 1140        NL$ = CHR$( 13 )
  60. 1150         RS$ = CHR$( 28 )
  61. 1160          LS$ = CHR$( 29 )
  62. 1170           US$ = CHR$( 30 )
  63. 1180            DS$ = CHR$( 31 )
  64. 1190             DEF FN K$( J ) = CHR$( 0 ) + CHR$( J )
  65. 1200              F1$ = FN K$( 59 )
  66. 1210               F2$ = FN K$( 60 )
  67. 1220                F3$ = FN K$( 61 )
  68. 1230                 F4$ = FN K$( 62 )
  69. 1240                  F5$ = FN K$( 63 )
  70. 1250  ECMD$ = "F1 HELP     F2 QUIT/RETURN     F3 SAVE/CONTINUE     F4 EDIT    F5 VIEW"
  71. 1260  DATA 85,184,0,6,183,7,185,2,5,186,76,18,205,16,93,203
  72. 1300    I = 0
  73. 1310     J = 0
  74. 1320      K = 0
  75. 1330       L = 0
  76. 1340        P = 0
  77. 1350         Q = 0
  78. 1360          ARG = 0
  79. 1370           ARG1 = 0
  80. 1380            ARG2 = 0
  81. 1390             U = 0
  82. 1400              V = 0
  83. 1410               X$ = ""
  84. 1420                Y$ = ""
  85. 1430                 W$ = ""
  86. 1440                  LIN$ = ""
  87. 1450                   ARG$ = ""
  88. 1460                    NVARS = 0
  89. 1470                     NDEFS = 0
  90. 1480                      NSUBS = 0
  91. 1490                       NCASE = 0<UNK! {0009}>
  92. 1500                        BPTR = 0
  93. 1510                         FPTR = 0
  94. 1520                          NPTR = 0
  95. 1530                           MAXPTR = 0<UNK! {0009}>
  96. 1540                            F0 = 0
  97. 1550                             F1 = 0
  98. 1560                              F2 = 0
  99. 1570                               FF = 0
  100. 1580                                VFLAG = 0<UNK! {0009}>
  101. 1590                                 FCMD = 0
  102. 1600                                  CMD = 0
  103. 1610                                   CMD$ = ""
  104. 1612   AW=0
  105. 1620   FPROMPT$ = ""
  106. 1630    FTYP$ = ""
  107. 1640     FTYP = 0<UNK! {0009}>
  108. 1650      ZPTR = 0
  109. 1660       JJ = 0
  110. 1670        CCASE = 0
  111. 1680         MAKE = 1
  112. 1690          EDYT = 2
  113. 1700           CASE = 3
  114. 1710            VARS = 4
  115. 1720             SUBS = 5
  116. 1730              DEFS = 6
  117. 1740               PRNT = 7
  118. 1750                EXIT = 8
  119. 1751                 XLAT = 9
  120. 1760                 HELP = 1
  121. 1770                  QRET = 2
  122. 1780                   QSAV = 3
  123. 1790                    REDO = 4
  124. 1800                     VYEW = 5
  125. 1810                      ESC = - 1
  126. 1820                       FC = 12<UNK! {0009}>
  127. 1830                        FD = 6<UNK! {0009}>
  128. 1840                         FJ = 4<UNK! {0009}>
  129. 1850                          FL = 13
  130. 1860                           FW = FL * FJ
  131. 1870                            NC = ( FC + FD ) * FJ
  132. 1880                             FP = 5
  133. 1890                              FQ = ( ( 78 - NC ) / 2 ) - 1<UNK! {0009}>
  134. 1900                               MAXLIN = FC
  135. 1910  FC$ = SPACE$( FC )
  136. 1920   FD$ = SPACE$( FD - 3 )
  137. 1930    FE$ = SPACE$( FC + FD )
  138. 1940     FL$ = SPACE$( NC )
  139. 1950      NW$ = STRING$( FQ + 2,RS$ )
  140. 1951       EW$ = SPACE$(16)
  141. 1960       FILSPEC$ = ""
  142. 1970        FILDESC$ = ""
  143. 1980         MAXBUF = 127
  144. 1990          BVARS = 0
  145. 2000           BUFSIZ = MAXBUF
  146. 2010            GOSUB 4780
  147. 2020             J = BVARS + 2 * MAXLBLS + 1
  148. 2030              DIM W$( J )
  149. 2040               FOR K = 0 TO J
  150. 2050                W$( K ) = FC$
  151. 2060                 NEXT
  152. 2070  BUFSIZ = 32<UNK! {0009}>
  153. 2080  AW=VARPTR(EW$)
  154. 2081   AW=PEEK(AW+1)+256*PEEK(AW+2)
  155. 2082    RESTORE 1260
  156. 2083    FOR J = 0 TO 15
  157. 2084     READ P
  158. 2085      POKE AW+J,P
  159. 2086       NEXT
  160. 2090  CLS
  161. 2100   RETURN
  162. 2110  LOCATE P,Q
  163. 2120   RETURN
  164. 2130  LOCATE ,,1
  165. 2140   X$ = INKEY$
  166. 2150    IF X$ = "" THEN 2130
  167. 2160  GOSUB 2200
  168. 2170   IF X$ = "" THEN 2130
  169. 2180  LOCATE ,,0
  170. 2190   RETURN
  171. 2200  FCMD = 0
  172. 2210   IF X$ > = " " OR X$ = CR$ OR X$ = CHR$( 8 ) THEN RETURN
  173. 2215  IF X$ = ESC$ THEN FCMD= ESC : RETURN
  174. 2220  IF X$ = F1$ THEN GOSUB 9300:FCMD=HELP:RETURN
  175. 2230  IF X$ = F2$ THEN FCMD = QRET : RETURN
  176. 2240  IF X$ = F3$ THEN FCMD = QSAV : RETURN
  177. 2250  IF X$ = F4$ THEN FCMD = REDO : RETURN
  178. 2260  IF X$ = F5$ THEN GOSUB 9710:FCMD=VYEW:RETURN
  179. 2280  X$ = ""
  180. 2290   RETURN
  181. 2300  GOSUB 3510:PRINT "YOUR CHOICE";
  182. 2320    GOSUB 2340
  183. 2330     RETURN
  184. 2340  PRINT " ";
  185. 2345   GOSUB 2130
  186. 2350   CMD = 0
  187. 2360    IF FCMD < > 0 THEN RETURN
  188. 2370  GOSUB 2660
  189. 2380   CMD = INSTR( CMD$,X$ )
  190. 2390    IF CMD THEN RETURN
  191. 2400  GOTO 2345
  192. 2410  PRINT " Y/N";
  193. 2430    CMD$ = "YN"
  194. 2440     GOSUB 2340
  195. 2450      RETURN
  196. 2460  PRINT " <CR> TO CONTINUE";
  197. 2480    CMD$ = CR$
  198. 2490     GOSUB 2340
  199. 2500      RETURN
  200. 2510  PRINT " ";
  201. 2515   LIN$=SPACE$(MAXLIN):J=0
  202. 2530    GOSUB 2550
  203. 2535  IF J THEN LIN$=LEFT$(LIN$,J) ELSE LIN$=""
  204. 2536  IF LIN$<=SPACE$(MAXLIN) THEN LIN$=""
  205. 2540     RETURN
  206. 2550  GOSUB 2130
  207. 2560   IF FCMD < > 0 THEN J=0: RETURN
  208. 2570  IF X$ > = " " AND J<MAXLIN THEN GOSUB 2610
  209. 2580  IF X$ = CHR$( 8 ) AND J>0 THEN GOSUB 2630
  210. 2590  IF X$ <> CR$ THEN 2550
  211. 2605  RETURN
  212. 2610  J=J+1
  213. 2615   MID$(LIN$,J)=X$
  214. 2616   PRINT X$;
  215. 2620    RETURN 
  216. 2630  MID$(LIN$,J)=" "
  217. 2640   PRINT LS$" "LS$;
  218. 2645    J=J-1
  219. 2650     RETURN
  220. 2660  IF X$ = "" THEN RETURN ELSE J = ASC(X$)
  221. 2680   IF J > 96 AND J < 123 THEN X$=CHR$(J - 32)
  222. 2700   RETURN
  223. 2710  IF X$ = "" THEN RETURN ELSE J = ASC( X$ )
  224. 2730   IF J > 64 AND J < 91 THEN X$=CHR$(J+32)
  225. 2750   RETURN
  226. 2760  P = 1
  227. 2770   Q = 20
  228. 2780    GOSUB 2110
  229. 2790     PRINT SPACE$( 40 );
  230. 2800      X$ = " >>>  " + X$ + "  <<< "
  231. 2810       Q = 40 - LEN( X$ ) \ 2
  232. 2820        GOSUB 2110
  233. 2830         COLOR 0,7
  234. 2840          PRINT X$;
  235. 2850           COLOR 7,0
  236. 2860            RETURN
  237. 2870  P = FP - 1
  238. 2880   Q = 40
  239. 2890    GOSUB 2110
  240. 2900     PRINT SPACE$( 40 - FQ );
  241. 2910      Q = 80 - FQ - LEN( X$ )
  242. 2920       GOSUB 2110
  243. 2930        PRINT X$;
  244. 2940         RETURN
  245. 2950  P = FP - 1
  246. 2960   Q = FQ + 1
  247. 2970    GOSUB 2110
  248. 2980     PRINT SPACE$( 40 - FQ - 1 )
  249. 2990      GOSUB 2110
  250. 3000       PRINT X$;
  251. 3010        RETURN
  252. 3020  X$ = FILSPEC$
  253. 3030   IF X$ = "" THEN X$ = "NO FILE OPENED" : GOSUB 2950 : X$ = "" : GOSUB 2870 : RETURN
  254. 3040  IF FILDESC$ < > "" THEN X$ = X$ + "/" + FILDESC$
  255. 3050  X$ = "FILE: " + X$
  256. 3060   GOSUB 2950
  257. 3070    X$ = "NO"
  258. 3080     IF NCASE < > 0 THEN X$ = STR$( NCASE )
  259. 3090  IF NCASE < > 1 THEN X$ = X$ + " CASES ENTERED" : GOSUB 2870 : RETURN
  260. 3100  X$ = "1 CASE ENTERED"
  261. 3110   GOSUB 2870
  262. 3120    RETURN
  263. 3130  P = FP:COLOR 0,7
  264. 3140   K = FP + 1 + FL
  265. 3150    FOR Q = FQ + 1 TO 79 - FQ
  266. 3160     GOSUB 2110
  267. 3180       PRINT CHR$( 205 );
  268. 3200         NEXT
  269. 3210          GOSUB 2110
  270. 3230            PRINT CHR$( 187 );
  271. 3240             FOR P = FP + 1 TO K
  272. 3250              GOSUB 2110
  273. 3260               PRINT CHR$( 186 );
  274. 3270                NEXT
  275. 3280                 GOSUB 2110
  276. 3290                  PRINT CHR$( 188 );
  277. 3300  FOR Q = 79 - FQ TO FQ + 1 STEP - 1
  278. 3310   GOSUB 2110
  279. 3320    PRINT CHR$( 205 );
  280. 3330     NEXT
  281. 3340      GOSUB 2110
  282. 3350       PRINT CHR$( 200 );
  283. 3360        FOR P = K TO FP + 1 STEP - 1
  284. 3370         GOSUB 2110
  285. 3380          PRINT CHR$( 186 );
  286. 3390           NEXT
  287. 3400            GOSUB 2110
  288. 3410             PRINT CHR$( 201 );
  289. 3420              COLOR 7,0
  290. 3430               X$=ECMD$
  291. 3440  P = 21
  292. 3450   Q = FQ + 2
  293. 3460    GOSUB 3610
  294. 3470     Q = 40 - LEN( X$ ) \ 2
  295. 3480      GOSUB 2110
  296. 3490       PRINT X$;
  297. 3500        RETURN
  298. 3510  P = 23
  299. 3520   Q = FQ + 2
  300. 3530    GOSUB 3610
  301. 3550      RETURN
  302. 3560  GOSUB 2460
  303. 3600      RETURN
  304. 3610  GOSUB 2110
  305. 3620   PRINT SPACE$( 79 - Q );
  306. 3630    GOSUB 2110
  307. 3640     RETURN
  308. 3650  CALL AW
  309. 3720  P= FP + 2
  310. 3730   Q = FQ + 3
  311. 3740    GOSUB 2110
  312. 3750     RETURN
  313. 3780  GOSUB 3650
  314. 3790  IF F2 = F0 - 1 THEN PRINT "NOTHING ENTERED":RETURN
  315. 3800   F1 = FW * ( F1 \ FW )
  316. 3810    IF F1 > ( F2 - F0 + 1 ) OR F1 < 0 THEN F1 = 0
  317. 3820  K=0
  318. 3830   FOR J = F0+F1 TO F2
  319. 3840    LSET FD$=MID$(STR$(J-F0+1),2)
  320. 3850     PRINT F$FD$": "W$(J);
  321. 3860      K=K+1
  322. 3870       IF K MOD FJ = 0 THEN PRINT:PRINT NW$;
  323. 3880        NEXT
  324. 3890         RETURN
  325. 3900  '
  326. 4060  GOSUB 3650
  327. 4070  READ X$
  328. 4080   IF X$ <> "" THEN PRINT X$:PRINT NW$;:GOTO 4070
  329. 4090  RETURN
  330. 4100  '
  331. 4180  FCMD = 0
  332. 4190   ON ERROR GOTO 4460
  333. 4200  GOSUB 3510 : PRINT "LOADING " + FILNAM$;
  334. 4220    FILTYP=1
  335. 4230     OPEN "I",#1,FILSPEC$+".STL"
  336. 4240      INPUT #1,FILNAM$,FILDESC$,BUFSIZ
  337. 4250       GOSUB 4780
  338. 4260        INPUT #1,NVARS,NDEFS,NSUBS,NCASE
  339. 4270         FOR J = 1 TO NVARS
  340. 4280          INPUT #1,X$
  341. 4290           LSET W$( BVARS + J ) = X$
  342. 4300            NEXT
  343. 4310  FOR J = 1 TO NDEFS
  344. 4320   INPUT #1,X$
  345. 4330    LSET W$( BDEFS + J ) = X$
  346. 4340     NEXT
  347. 4350      FOR J = 1 TO NSUBS
  348. 4360       INPUT #1,X$
  349. 4370        LSET W$( BSUBS + J ) = X$
  350. 4380         NEXT
  351. 4390          CLOSE #1
  352. 4400           GOSUB 4860
  353. 4410            GOSUB 3020
  354. 4420  DDSFLAG = 0
  355. 4430   STLFLAG = 0
  356. 4440    ON ERROR GOTO 6190
  357. 4450     RETURN
  358. 4460  GOSUB 3510 : PRINT "CAN'T OPEN " + FILSPEC$;
  359. 4465  IF FILTYP=1 THEN PRINT ".STL"; ELSE IF FILTYP=2 THEN PRINT ".DAT";
  360. 4470   GOSUB 2460
  361. 4480    FILSPEC$ = ""
  362. 4485  <UNK! {0009}>FILTYP=0
  363. 4490     CLOSE
  364. 4500      FCMD = REDO
  365. 4510       RESUME 4420
  366. 4520  GOSUB 5730
  367. 4530   CLOSE #1
  368. 4540    IF STLFLAG = 0 THEN RETURN
  369. 4550  GOSUB 3510 : PRINT "SAVING " + FILNAM$ + " CONTROL FILE";
  370. 4570    FILTYP=1
  371. 4580     OPEN "O",#1,FILSPEC$+".STL"
  372. 4590      PRINT #1,FILNAM$
  373. 4600       PRINT #1,FILDESC$
  374. 4610        PRINT #1,BUFSIZ
  375. 4620         PRINT #1,NVARS
  376. 4630          PRINT #1,NDEFS
  377. 4640           PRINT #1,NSUBS
  378. 4650            PRINT #1,NCASE
  379. 4660             FOR J = 1 TO NVARS
  380. 4670              PRINT #1,W$( BVARS + J )
  381. 4680               NEXT
  382. 4690  FOR J = 1 TO NDEFS
  383. 4700   PRINT #1,W$( BDEFS + J )
  384. 4710    NEXT
  385. 4720     FOR J = 1 TO NSUBS
  386. 4730      PRINT #1,W$( BSUBS + J )
  387. 4740       NEXT
  388. 4750        CLOSE #1
  389. 4760         STLFLAG = 0
  390. 4770          RETURN
  391. 4780  MAXVARS = BUFSIZ
  392. 4790   MAXDEFS = BUFSIZ \ 4
  393. 4800    MAXSUBS = BUFSIZ
  394. 4810     MAXLBLS = MAXVARS + MAXDEFS + MAXSUBS
  395. 4820      BDEFS = BVARS + MAXVARS
  396. 4830       BSUBS = BDEFS + MAXDEFS
  397. 4840        BVALS = BSUBS + MAXSUBS
  398. 4850         RETURN
  399. 4860  GOSUB 4780
  400. 4870   FILTYP=2
  401. 4880    OPEN "R",#1,FILSPEC$+".DAT",BUFSIZ
  402. 4890     FIELD#1,BUFSIZ AS CB$
  403. 4900      RETURN
  404. 4910  GOSUB 3510 : PRINT "SAVING CASE NUMBER" + STR$( CCASE );
  405. 4930    X$=SPACE$(2*BUFSIZ)
  406. 4940     K = BVALS
  407. 4950      FOR J = 1 TO NVARS
  408. 4960       MID$(X$,(J-1)*2+1)=MKI$( VAL( W$( K + J ) ) )
  409. 4970        NEXT
  410. 5000           LSET CB$ = X$
  411. 5010            PUT #1,4 * CCASE - 3
  412. 5020             LSET CB$ = RIGHT$(X$,BUFSIZ)
  413. 5030              PUT #1
  414. 5050   K = K + MAXVARS
  415. 5060    FOR J = 1 TO NDEFS
  416. 5070     MID$(CB$,(J-1)*4+1) = MKS$( VAL( W$( K + J ) ) )
  417. 5080      NEXT
  418. 5100        PUT #1
  419. 5120          K = K + MAXDEFS
  420. 5130           FOR J = 1 TO NSUBS
  421. 5140            MID$(CB$,J)=MID$( W$( K + J ),2,1 )
  422. 5150             NEXT
  423. 5170               PUT #1
  424. 5180                RETURN
  425. 5190  K = BVALS
  426. 5195   X$=SPACE$(2*BUFSIZ)
  427. 5200   GET #1,4 * CCASE - 3
  428. 5210    LSET X$ = CB$
  429. 5220     GET #1
  430. 5230      MID$(X$,BUFSIZ+1)=CB$
  431. 5240       FOR J = 1 TO NVARS
  432. 5250        LSET W$( K + J ) = STR$( CVI( MID$( X$,J + J - 1 ) ) )
  433. 5260         NEXT
  434. 5270          K = K + MAXVARS
  435. 5280           GET #1
  436. 5290            FOR J = 1 TO NDEFS
  437. 5300             LSET W$( K + J ) = STR$( CVS( MID$( CB$,J * 4 - 3 ) ) )
  438. 5310              NEXT
  439. 5320               K = K + MAXDEFS
  440. 5330                GET #1
  441. 5340  FOR J = 1 TO NSUBS
  442. 5350   LSET W$( K + J ) = " " + MID$( CB$,J,1 )
  443. 5360    NEXT
  444. 5370     X$ = "CASE" + STR$( CCASE ) + " OF" + STR$( NCASE )
  445. 5380      GOSUB 2870
  446. 5390       GOSUB 10120
  447. 5400        RETURN
  448. 5410  X$="CALCULATING DEFINITIONS"
  449. 5420   GOSUB 2870
  450. 5430    GOSUB 5470
  451. 5440     GOSUB 4910
  452. 5450      IF CCASE = NCASE + 1 THEN NCASE = CCASE
  453. 5460  RETURN
  454. 5470  LIN$ = FC$
  455. 5490    FOR ZPTR = BDEFS + 1 TO BDEFS + NDEFS
  456. 5500     LSET LIN$ = W$( ZPTR )
  457. 5510      GOSUB 10360
  458. 5520       LSET W$( ZPTR + MAXLBLS ) = STR$( V )
  459. 5530        NEXT
  460. 5540         FOR ZPTR = BSUBS + 1 TO BSUBS + NSUBS
  461. 5550          LSET LIN$ = W$( ZPTR )
  462. 5560           GOSUB 10360
  463. 5570            LSET W$( ZPTR + MAXLBLS ) = STR$( V )
  464. 5580             NEXT
  465. 5590              RETURN
  466. 5600  K = BVALS
  467. 5610   FOR J = K + 1 TO K + NVARS
  468. 5620    LSET W$( J ) = FC$
  469. 5630     NEXT
  470. 5640      K = K + MAXVARS
  471. 5650       FOR J = K + 1 TO K + NDEFS
  472. 5660        LSET W$( J ) = FC$
  473. 5670         NEXT
  474. 5680          K = K + MAXDEFS
  475. 5690           FOR J = K + 1 TO K + NSUBS
  476. 5700            LSET W$( J ) = FC$
  477. 5710             NEXT
  478. 5720              RETURN
  479. 5730  IF DDSFLAG = 0 THEN RETURN
  480. 5740  GOSUB 3510 : PRINT "REWRITING DEFINITION FILES";
  481. 5760    J = FRE( 0 )
  482. 5770     FOR CCASE = 1 TO NCASE
  483. 5780      GOSUB 5190
  484. 5790       GOSUB 5470
  485. 5800        GOSUB 4910
  486. 5810         NEXT
  487. 5820          DDSFLAG = 0
  488. 5830           RETURN
  489. 5840  DATA"STATLIB EDITOR":DATA"COISDPHTE"
  490. 5845  DATA" "
  491. 5846  DATA" "
  492. 5850  DATA"       (C)REATE A NEW FILE            (I)NPUT/EDIT CASE DATA"
  493. 5852  DATA" "
  494. 5854  DATA"       (O)PEN EXISTING FILE           (S)UBSET DEFINITION"
  495. 5856  DATA" "
  496. 5858  DATA"       (P)RINT CASE FILE              (D)EFINE DERIVED VARIABLES"
  497. 5860  DATA" "
  498. 5862  DATA"       (E)XIT PROGRAM                 (T)RANSLATE *.DIF TO *.STL"
  499. 5864  DATA" "
  500. 5866  DATA"                          (H)ELP SCREEN"
  501. 5868  DATA""
  502. 5870  RESTORE 5840
  503. 5872   MD=MAIN
  504. 5874    ON ERROR GOTO 6190
  505. 5880    READ X$
  506. 5890     READ CMD$
  507. 5900      GOSUB 2760
  508. 5910       GOSUB 3020
  509. 5920        GOSUB 4060
  510. 5950           GOSUB 2300
  511. 5960            IF CMD = 9 THEN 5990
  512. 5970  ON CMD GOSUB 6250,6710,6960,7530,7490,11780,6220,20000
  513. 5980   GOTO 5840
  514. 5990  MD = EXIT
  515. 6000   IF FILSPEC$ < > "" THEN GOSUB 4520
  516. 6005  GOSUB 3650
  517. 6010   GOSUB 3510 : PRINT "GOODBYE...";
  518. 6030    FOR J = 1 TO 2200
  519. 6040     NEXT
  520. 6050      GOSUB 2090
  521. 6060  KEY ON
  522. 6070   KEY 1,"LIST"
  523. 6080    KEY 2,"RUN" + CHR$( 13 )
  524. 6090     KEY 3,"LOAD" + CHR$( 34 )
  525. 6100      KEY 4,"SAVE" + CHR$( 34 )
  526. 6110       KEY 5,"CONT" + CHR$( 13 )
  527. 6120        KEY 6,"," + CHR$( 34 ) + "LPT1:"
  528. 6130         KEY 7,"TRON" + CHR$( 13 )
  529. 6140          KEY 8,"TROFF" + CHR$( 13 )
  530. 6150           KEY 9,"KEY"
  531. 6160            KEY 10,"SCREEN 0,0,0" + CHR$( 13 )
  532. 6170             REM NEW
  533. 6180              END
  534. 6190  GOSUB 3510 : PRINT "ERROR" + STR$( ERR ) + "IN LINE" + STR$( ERL )
  535. 6210    RESUME
  536. 6220  MD = 0
  537. 6230   GOSUB 9300
  538. 6240    RETURN
  539. 6250  MD = MAKE
  540. 6260   X$ = "CREATE FILE"
  541. 6270    GOSUB 2760
  542. 6275     GOSUB 3650
  543. 6280     GOSUB 8460
  544. 6290      IF FCMD = QRET THEN RETURN
  545. 6300  GOSUB 3020
  546. 6310   GOSUB 6450
  547. 6320    IF FCMD = QRET THEN RETURN
  548. 6330  FOR J = BVARS + 1 TO BVALS
  549. 6340   LSET W$( J ) = FC$
  550. 6350    NEXT
  551. 6360     NVARS = 0
  552. 6370      NDEFS = 0
  553. 6380       NSUBS = 0
  554. 6390        NCASE = 0
  555. 6400         DDSFLAG = 0
  556. 6410          GOSUB 7440
  557. 6420           GOSUB 4520
  558. 6430            GOSUB 4860
  559. 6440             RETURN
  560. 6450  GOSUB 3650
  561. 6460   GOSUB 4780
  562. 6470    PRINT "NUMBER OF VARIABLES ALLOWED:"; STR$( BUFSIZ )
  563. 6480     PRINT NW$;"NUMBER OF DEFINITIONS ALLOWED:"; STR$( MAXDEFS )
  564. 6485      PRINT NW$"NUMBER OF SUBSETS ALLOWED:"; STR$( MAXSUBS )
  565. 6490       PRINT NW$"EACH CASE WILL REQUIRE"STR$(4*BUFSIZ)" BYTES"
  566. 6495        PRINT
  567. 6520   PRINT NW$;"CHOOSE THE SMALLEST POSSIBLE NUMBER OF VARIABLES"
  568. 6530    PRINT NW$;"COMMENSURATE WITH YOUR NEEDS (BETWEEN 4 AND 127)."
  569. 6540  '
  570. 6590  GOSUB 3510 : PRINT "GO AHEAD WITH THIS NUMBER OF VARIABLES";
  571. 6600   GOSUB 2410
  572. 6610    IF X$ = "Y" THEN RETURN
  573. 6615     IF FCMD=QRET OR FCMD=ESC THEN RETURN
  574. 6616      IF FCMD THEN 6450
  575. 6620  GOSUB 3510 : PRINT "ENTER NUMBER OF VARIABLES";
  576. 6625   MAXLIN=3
  577. 6630   GOSUB 2510
  578. 6640    IF FCMD = QRET OR FCMD = QSAV THEN RETURN
  579. 6650  IF FCMD < > 0 THEN 6450
  580. 6660  J = VAL( LIN$ )
  581. 6670   IF J < 4 THEN J = 4
  582. 6680  IF J > MAXBUF THEN J = MAXBUF
  583. 6690  BUFSIZ = J
  584. 6700   GOTO 6450
  585. 6710  MD = EDYT
  586. 6720   X$ = "OPEN FILE"
  587. 6730    GOSUB 2760
  588. 6735     GOSUB 3650
  589. 6740     GOSUB 8460
  590. 6750      IF FCMD = QRET THEN RETURN
  591. 6760  IF FCMD THEN 6710
  592. 6770  GOSUB 4180
  593. 6780   IF FCMD = REDO THEN 6710
  594. 6790  GOSUB 9910
  595. 6800   GOSUB 3510 : PRINT "ARE THE LABELS CORRECT";
  596. 6810    GOSUB 2410
  597. 6820     IF FCMD = QRET THEN RETURN
  598. 6830      IF FCMD=HELP OR FMCD=VYEW THEN 6790
  599. 6840  IF X$ = "N" THEN GOSUB 7440
  600. 6850  IF NCASE = 0 THEN RETURN
  601. 6860  GOSUB 3510 : PRINT "DO YOU WISH TO VIEW CASES";
  602. 6870   GOSUB 2410
  603. 6880    IF X$ = "Y" THEN GOSUB 6900
  604. 6885  IF FCMD=VYEW OR FCMD=HELP THEN GOTO 6860
  605. 6890  RETURN
  606. 6900  X$ = "VIEWING CASES"
  607. 6910   GOSUB 2760
  608. 6920    GOSUB 9150
  609. 6930     IF FCMD = QRET THEN RETURN
  610. 6940      GOTO 6900
  611. 6960  DATA"INPUT NEW CASES":DATA"ENTER VALUE FOR","X",4:IF FILSPEC$=""THEN GOSUB 8910:RETURN
  612. 6970  CASEFLAG = 1
  613. 6975  MD=CASE
  614. 6980   RESTORE 6960
  615. 6990    READ X$
  616. 7000     GOSUB 2760
  617. 7010      READ FPROMPT$,FTYP$,FTYP
  618. 7020       BPTR = BVALS
  619. 7030        MAXPTR = BPTR + NVARS
  620. 7040         GOSUB 3510 : PRINT "F4 WILL TOGGLE EDIT MODE";
  621. 7045  IF FCMD=REDO THEN 7180
  622. 7046  IF FCMD=QRET OR FCMD=ESC THEN RETURN
  623. 7047  IF FCMD THEN 6970
  624. 7050          GOSUB 2460
  625. 7060  CCASE = NCASE + 1
  626. 7070   GOSUB 5600
  627. 7080    FOR J = 1 TO NVARS
  628. 7090     LSET W$( BVALS + J ) = W$( BVARS + J )
  629. 7100      NEXT
  630. 7110       X$ = "ENTERING NEW CASE NUMBER" + STR$( CCASE )
  631. 7120        GOSUB 2870
  632. 7130         NPTR = BPTR
  633. 7140          GOSUB 7380
  634. 7150           IF FCMD = REDO THEN 7180
  635. 7160  IF FCMD = QRET THEN RETURN
  636. 7170  GOTO 7060
  637. 7180  DATA"REENTER CASES":DATA"REENTER VALUE FOR","X",4:IF FILSPEC$=""THEN GOSUB 8910:RETURN
  638. 7190  CASEFLAG = 2
  639. 7200   RESTORE 7180
  640. 7210    READ X$
  641. 7220     GOSUB 2760
  642. 7230      READ FPROMPT$,FTYP$,FTYP
  643. 7240       BPTR = BVALS
  644. 7250        MAXPTR = BPTR + NVARS
  645. 7260         X$ = ""
  646. 7270          GOSUB 2870
  647. 7280           GOSUB 3510 : PRINT "F4 WILL TOGGLE INPUT NEW CASES MODE";
  648. 7290            GOSUB 2460
  649. 7300  GOSUB 9150
  650. 7310   IF FCMD = REDO THEN 6960
  651. 7320  IF FCMD = QRET THEN RETURN
  652. 7330  IF FCMD < > 0 THEN 7300
  653. 7340  NPTR = MAXPTR
  654. 7350   FPTR = BPTR + 1
  655. 7360    GOSUB 7380
  656. 7370     GOTO 7300
  657. 7380  MD = CASE
  658. 7390   IF CASEFLAG = 2 THEN GOSUB 7880  ELSE GOSUB 7700
  659. 7400  IF FCMD = ESC THEN 7380
  660. 7410  IF FCMD = QSAV THEN IF ( CASEFLAG = 2 OR ( CASEFLAG = 1 AND NPTR = MAXPTR ) ) THEN GOSUB 5410 : STLFLAG = STLFLAG + 1 : RETURN
  661. 7420  IF FCMD = REDO OR FCMD = QRET THEN RETURN
  662. 7430  GOTO 7380
  663. 7440  DATA"ENTER VARIABLE NAME FOR","X",1:MD=VARS:RESTORE 7440:READ FPROMPT$,FTYP$,FTYP:BPTR=BVARS:NPTR=BPTR+NVARS:MAXPTR=BPTR+MAXVARS:IF NCASE<>0 THEN MAXPTR=NPTR
  664. 7450  IF FILSPEC$ = "" THEN GOSUB 8910 : RETURN
  665. 7460  IF DDSFLAG = 0 AND NCASE > 0 THEN GOSUB 7570 : IF X$ < > "Y" THEN RETURN
  666. 7470  GOSUB 7600
  667. 7480   RETURN
  668. 7490  DATA"DEFINE DERIVED VARIABLES":DATA"ENTER DATA DEFINITION FOR","D",2:MD=DEFS:RESTORE 7490:READ X$:GOSUB 2760:READ FPROMPT$,FTYP$,FTYP:BPTR=BDEFS:NPTR=BPTR+NDEFS:MAXPTR=BPTR+MAXDEFS:IF FILSPEC$=""THEN GOSUB 8910:RETURN
  669. 7500  IF DDSFLAG = 0 AND NCASE > 0 THEN GOSUB 7570 : IF X$ < > "Y" THEN RETURN
  670. 7510  GOSUB 7600
  671. 7520   RETURN
  672. 7530  DATA"DEFINE SUBSETS":DATA"ENTER SUBSET DEFINITION FOR","S",3:MD=SUBS:RESTORE 7530:READ X$:GOSUB 2760:READ FPROMPT$,FTYP$,FTYP:BPTR=BSUBS:NPTR=BPTR+NSUBS:MAXPTR=BPTR+MAXSUBS:IF FILSPEC$=""THEN GOSUB 8910:RETURN
  673. 7540  IF DDSFLAG = 0 AND NCASE > 0 THEN GOSUB 7570 : IF X$ < > "Y" THEN RETURN
  674. 7550  GOSUB 7600
  675. 7560   RETURN
  676. 7570  GOSUB 3510 : PRINT "WILL REQUIRE REWRITING DEFINITION FILES. OK TO PROCEED";
  677. 7580   GOSUB 2410
  678. 7590    RETURN
  679. 7600  CASEFLAG = 0
  680. 7610   X$ = "NO"
  681. 7620    IF NCASE > 0 THEN X$ = STR$( NCASE )
  682. 7630  X$ = X$ + " CASES ENTERED"
  683. 7640   GOSUB 2870
  684. 7650    GOSUB 7700
  685. 7660     IF FCMD = ESC OR FCMD = REDO THEN 7600
  686. 7670  IF FCMD = QSAV THEN STLFLAG = STLFLAG + 1 : IF NCASE > 0 THEN DDSFLAG = DDSFLAG + 1
  687. 7680  IF FCMD = QRET OR FCMD = QSAV THEN RETURN
  688. 7690  GOTO 7650
  689. 7700  IF NPTR > = MAXPTR THEN 7800
  690. 7710  FPTR = NPTR + 1
  691. 7720   GOSUB 8940
  692. 7730    IF FCMD = ESC THEN 7700
  693. 7740  IF FCMD = REDO AND CASEFLAG = 1 AND NPTR = BPTR THEN RETURN
  694. 7750  IF FCMD = REDO THEN 7880
  695. 7760  IF FCMD = QSAV OR FCMD = QRET THEN RETURN
  696. 7765  IF FCMD THEN 7700
  697. 7770  IF NPTR < MAXPTR THEN NPTR = NPTR + 1 : GOSUB 8380
  698. 7780  LSET W$( NPTR ) = W$
  699. 7790   RETURN
  700. 7800  FPTR = NPTR
  701. 7810   GOSUB 10300
  702. 7820    GOSUB 3510 : PRINT "FILLED...OK TO ENTER";
  703. 7830     GOSUB 2410
  704. 7840      IF X$ = "Y" THEN FCMD = QSAV : RETURN
  705. 7850  IF FCMD = ESC THEN 7800
  706. 7860  IF FCMD = QRET THEN RETURN
  707. 7870  GOTO 7880
  708. 7880  GOSUB 10300
  709. 7885  GOSUB 3510 : PRINT "(D)ELETE   (I)NSERT   (R)EENTER   (C)LEAR";
  710. 7900    CMD$ = "DIRC"
  711. 7910     GOSUB 2340
  712. 7920      IF FCMD = HELP OR FCMD =VYEW THEN 7880
  713. 7930  IF FCMD THEN RETURN
  714. 7940  ON CMD GOSUB 7980,8070,8190,8270
  715. 7950   IF FCMD = HELP OR FCMD=VYEW THEN 7880
  716. 7960    FCMD=0
  717. 7970     RETURN
  718. 7980  GOSUB 9060
  719. 8000  IF FCMD < > 0 THEN RETURN
  720. 8010  FOR J = FPTR TO NPTR - 1
  721. 8020   LSET W$( J ) = W$( J + 1 )
  722. 8030    NEXT
  723. 8040     LSET W$( NPTR ) = FC$
  724. 8050      IF ( FTYP > 1 AND FTYP < 4 ) OR ( FTYP = 1 AND NCASE = 0 ) THEN NPTR = NPTR - 1 : GOSUB 8380
  725. 8060  RETURN
  726. 8070  GOSUB 9060
  727. 8090  IF FCMD < > 0 THEN RETURN
  728. 8100  GOSUB 8940
  729. 8110   IF FCMD THEN RETURN
  730. 8130  IF NPTR < MAXPTR THEN NPTR = NPTR + 1 : GOSUB 8380
  731. 8140  FOR J = NPTR - 1 TO FPTR STEP - 1
  732. 8150   LSET W$( J + 1 ) = W$( J )
  733. 8160    NEXT
  734. 8170     LSET W$( FPTR ) = W$
  735. 8180      RETURN
  736. 8190  GOSUB 9060
  737. 8210  IF FCMD < > 0 THEN RETURN
  738. 8220  GOSUB 8940
  739. 8230   IF FCMD THEN RETURN
  740. 8250  LSET W$( FPTR ) = W$
  741. 8260   RETURN
  742. 8270  FPTR = BPTR + 1
  743. 8280   GOSUB 10300
  744. 8290    GOSUB 3510 : PRINT "OK TO CLEAR ALL ENTRIES";
  745. 8300     GOSUB 2410
  746. 8310      IF X$ < > "Y" THEN RETURN
  747. 8320  NPTR = BPTR
  748. 8330   FOR J = FPTR TO MAXPTR
  749. 8340    LSET W$( J ) = ""
  750. 8350     NEXT
  751. 8360      IF ( FTYP > 1 AND FTYP < 4 ) OR ( FTYP = 1 AND NCASE = 0 ) THEN GOSUB 8380
  752. 8370  RETURN
  753. 8380  ON FTYP GOSUB 8400,8420,8440
  754. 8390   RETURN
  755. 8400  NVARS = NPTR - BPTR
  756. 8410   RETURN
  757. 8420  NDEFS = NPTR - BPTR
  758. 8430   RETURN
  759. 8440  NSUBS = NPTR - BPTR
  760. 8450   RETURN
  761. 8460  IF FILSPEC$ = "" THEN 8540
  762. 8470  GOSUB 3510 : PRINT "OK TO CLOSE "FILNAM$;
  763. 8480   GOSUB 2410
  764. 8490    IF X$ < > "Y" THEN FCMD = QRET : RETURN
  765. 8500  GOSUB 4520
  766. 8510   FILSPEC$ = ""
  767. 8520    NCASE = 0
  768. 8530     GOSUB 3020
  769. 8540  GOSUB 8660
  770. 8550   IF FCMD = QRET THEN RETURN
  771. 8560  IF FCMD < > 0 THEN 8540
  772. 8570  GOSUB 8750
  773. 8580   IF FCMD = QRET THEN RETURN
  774. 8590  IF FCMD = ESC THEN 8540
  775. 8600  IF MD = MAKE THEN GOSUB 8850
  776. 8610  IF FCMD = QRET THEN RETURN
  777. 8620  X$ = FILNAM$
  778. 8630   IF FILDRV$ < > "" THEN X$ = FILDRV$ + ":" + X$
  779. 8640  FILSPEC$ = X$
  780. 8650   RETURN
  781. 8660  GOSUB 3510 : PRINT "ENTER FILENAME";
  782. 8670   MAXLIN = 8
  783. 8680    GOSUB 2510
  784. 8690     IF FCMD = ESC THEN 8660
  785. 8700  IF FCMD = QRET THEN RETURN
  786. 8705  IF FCMD THEN 8660
  787. 8710  IF LIN$ < = SPACE$( 8 ) THEN LIN$ = FILNAM$
  788. 8720  FILNAM$ = LIN$
  789. 8730   IF FILNAM$ = "" THEN FCMD = QRET
  790. 8740  RETURN
  791. 8750  GOSUB 3510 : PRINT "ON DRIVE";
  792. 8760   CMD$=CR$+"ABCD"
  793. 8770    GOSUB 2340
  794. 8780     IF FCMD = ESC THEN 8660
  795. 8790  IF FCMD = QRET THEN RETURN
  796. 8795  IF FCMD THEN 8660
  797. 8800  IF X$=CR$ THEN X$=""
  798. 8810  FILDRV$=X$
  799. 8820    RETURN
  800. 8850  GOSUB 3510 : PRINT "ENTER FILE DESCRIPTION (25 CHARACTERS OR LESS)";
  801. 8860   MAXLIN = 25
  802. 8870    GOSUB 2510
  803. 8880     IF LIN$ < = SPACE$( 25 ) THEN LIN$ = ""
  804. 8890  FILDESC$ = LIN$
  805. 8900   RETURN
  806. 8910  GOSUB 3650
  807. 8915   GOSUB 3510 : PRINT "FILE MUST BE FIRST OPENED OR CREATED FROM MAIN MENU";
  808. 8920    GOSUB 3560
  809. 8930     RETURN
  810. 8940  GOSUB 10300
  811. 8950   GOSUB 3510 : PRINT FPROMPT$" "FTYP$MID$( STR$( FPTR - BPTR ),2 );
  812. 8960    IF FPTR > BVALS THEN PRINT  "  "W$( FPTR - MAXLBLS );
  813. 8980   GOSUB 9260
  814. 8990    IF FCMD = ESC THEN 8940
  815. 9000  IF FCMD < > 0 THEN RETURN
  816. 9010  GOSUB 10840
  817. 9020   IF CMD > 0 THEN RETURN
  818. 9030  GOSUB 3510 : PRINT LIN$"  "PROMPT$;
  819. 9040   GOSUB 3560
  820. 9050    GOTO 8940
  821. 9060  GOSUB 3510 : PRINT "ENTER FIELD NUMBER";
  822. 9070   GOSUB 9260
  823. 9080    IF FCMD = ESC THEN 9060
  824. 9090  IF FCMD < > 0 THEN RETURN
  825. 9100  J = VAL( LIN$ )
  826. 9110   IF J > = 1 AND J < = NPTR - BPTR THEN FPTR = BPTR + J : RETURN
  827. 9120  GOSUB 3510 : PRINT "BAD FIELD NUMBER";
  828. 9130   GOSUB 3560
  829. 9140    GOTO 9060
  830. 9150  GOSUB 3510 : PRINT "ENTER CASE NUMBER";
  831. 9160   GOSUB 9260
  832. 9170    IF FCMD = HELP OR FCMD=VYEW THEN 9150
  833. 9180  IF FCMD < > 0 THEN RETURN
  834. 9190  J = VAL( LIN$ )
  835. 9200   IF J > = 1 AND J < = NCASE THEN CCASE = J : GOTO 9240
  836. 9210  IF INSTR(LIN$,"-") THEN IF CCASE > 1 THEN CCASE = CCASE - 1:GOTO 9240
  837. 9220  IF INSTR(LIN$,"+") OR LIN$="" THEN IF CCASE < NCASE THEN CCASE = CCASE + 1:GOTO 9240
  838. 9230  GOSUB 3510:PRINT "BAD CASE NUMBER";:GOSUB 2460:GOTO 9150
  839. 9240  GOSUB 5190
  840. 9250   RETURN
  841. 9260   MAXLIN = FC
  842. 9280    GOSUB 2510
  843. 9290     RETURN
  844. 9300  IF MD = MAIN THEN RESTORE 9430
  845. 9310  IF MD = MAKE THEN RESTORE 9460
  846. 9320  IF MD = EDYT THEN RESTORE 9490
  847. 9330  IF MD = CASE THEN RESTORE 9520
  848. 9340  IF MD = VARS THEN RESTORE 9550
  849. 9350  IF MD = DEFS THEN RESTORE 9640
  850. 9360  IF MD = SUBS THEN RESTORE 9610
  851. 9365  IF MD = PRNT THEN RESTORE 9670
  852. 9370  IF MD = XLAT THEN RESTORE 19000
  853. 9380  IF MD = EXIT THEN RESTORE 9700
  854. 9390  GOSUB 4060
  855. 9400   GOSUB 3510
  856. 9410    GOSUB 2460
  857. 9415     GOSUB 3650
  858. 9416  FCMD=HELP
  859. 9420      RETURN
  860. 9430  DATA"MAIN HELP SCREEN":DATA" ":DATA"YOU MUST (C)REATE A NEW FILE, OR (O)PEN AN EXISTING FILE TO BEGIN.":DATA" ":DATA"DURING PROGRAM EXECUTION, USE F2 TO RETURN TO MAIN MENU.":DATA" 
  861. 9440  DATA"USE F3 WHENEVER ANY CHANGES HAVE BEEN MADE TO DATA -- SUCH AS AN ":DATA"ADD, DELETE, OR REENTER, OR TO SIGNAL YOU ARE CONTINUING A PROCESS.":DATA"USE THE F4 KEY FOR THE LINE EDITOR -- TO INSERT, DELETE, REENTER, ETC.":DATA" 
  862. 9450  DATA"USE THE ESCAPE KEY TO BACK UP ONE STEP. IF ESCAPE DOES NOT MOVE YOU,":DATA"USE F2 OR F3.":DATA"  ":DATA"":DATA" USE F5 TO VIEW PREVIOUSLY ENTERED LABELS, SUBSETS, AND DEFINITIONS.
  863. 9460  DATA"CREATE HELP SCREEN":DATA"  ":DATA"NO FILENAME EXTENSION SHOULD BE SPECIFIED AT THE FILENAME PROMPT.":DATA"  ":DATA"THE VARIABLE SIZE SETTING DETERMINES THE NUMBER OF VARIABLES ALLOWED.
  864. 9470  DATA"IF YOU NEED MORE SUBSETS, OR DEFINED VARIABLES THAN THE SETTING ALLOWS,":DATA"FEEL FREE TO USE A LARGER VARIABLE SETTING.":DATA"  ":DATA"UP TO 4000 CASES MAY BE ENTERED DEPENDING  ON THE AMOUNT OF MEMORY
  865. 9480  DATA"YOUR PC HAS AND THE DISK SPACE YOU HAVE AVAILABLE.":DATA"  ":DATA"USE THE F4 KEY TO REENTER OR EDIT LABELS.":DATA"
  866. 9490  DATA"OPEN HELP SCREEN":DATA"  ":DATA"OPENING A FILE WILL ALLOW YOU TO VIEW AND EDIT THE FILE'S LABELS;":DATA"ADD OR EDIT CASE DATA, SUBSETS, AND DERIVED DATA DEFINITIONS.":DATA"  
  867. 9500  DATA"NO FILE EXTENSION NEEDS TO BE SPECIFIED AT THE FILENAME PROMPT.":DATA"THE DISK DRIVE PROMPT ALLOWS YOU TO SELECT ANY DISK DRIVE, OR BY":DATA"TYPING A <CR> SELECT BASIC'S LOGGED DRIVE.":DATA"  
  868. 9510  DATA"AFTER THE FILE IS OPEN, YOU ARE PROMPTED TO REVIEW THE LABELS,":DATA"AND THE CASE DATA. THE PROGRAM WILL THEN RETURN TO THE MAIN MENU.":DATA"
  869. 9520  DATA"INPUT/EDIT HELP SCREEN":DATA"  ":DATA"THE EDIT KEY (F4) CAN BE USED TO EDIT CASES AS THEY ARE ENTERED OR ":DATA"AFTER THEY ARE ENTERED. TO SIMPLY VIEW CASES, PRESS THE F4 KEY, AND
  870. 9530  GOSUB 3510:PRINT "BAD CASE NUMBER":GOSUB 3560:GOTO 9150
  871. 9540  DATA"IF YOU CHANGE ANY DATA USING THE EDIT KEY, USE F3 TO SAVE AND CONTINUE.":DATA"  ":DATA"TO RETURN TO INPUT MODE FROM EDIT MODE, PRESS F4. ":DATA"
  872. 9550  DATA"VARIABLE LABELS HELP SCREEN":DATA"ENTER THE LABELS FOR YOUR VARIABLES. THE LABELS MAY BE":DATA"UP TO 10 CHARACTERS LONG. USE THE F4 EDIT KEY TO MAKE":DATA"ANY CHANGES.":DATA"  
  873. 9560  DATA"ONCE YOU HAVE ENTERED THESE LABELS, YOU WILL NOT BE ABLE":DATA"TO ADD OTHERS. HOWEVER, YOU CAN USE THE DEFINED VARIABLES":DATA"OPTION TO CREATE WHAT ARE, IN EFFECT, ADDITIONAL VARIABLES."
  874. 9570  DATA"  ":DATA "TO TOGGLE FROM THE EDIT (F4 KEY) MODE BACK TO ENTERING "
  875. 9580  DATA"LABELS, PRESS THE F4 KEY AGAIN.  "
  876. 9590  DATA"  "
  877. 9600  DATA"TO SAVE YOUR LABELS WHEN COMPLETED PRESS F3.":DATA ""
  878. 9610  DATA"SUBSET HELP SCREEN":DATA"LEGAL OPERATORS ARE:<>,<,<=,>,>=,REJIF0 (REJECT CASE IF ANY VALUE = 0":DATA"  ":DATA"SUBSETS MUST BE DEFINED AS: XNUMBER  OPERATOR  CONSTANT/XNUMBER
  879. 9620  DATA"THUS X1<3 IS A LEGAL SUBSET AND WILL SELECT ALL CASES WHERE THE ":DATA"VARIABLE X1 IS LESS THAN 3.":DATA"  ":DATA"IN GENERAL, SPECIFY ALL THE SUBSETS YOU NEED AT ONE TIME. THE
  880. 9630  DATA"LIBRARY PROGRAM WILL ALLOW YOU TO SELECT WHICH OF THESE TO USE":DATA"FOR A GIVEN ROUTINE.":DATA" ":DATA"IF REJIF0 IS SELECTED, ALL CASES HAVING A ZERO AS ANY VARIABLE VALUE":DATA"WILL BE REJECTED.":DATA"
  881. 9640  DATA"DEFINED DEFINITIONS HELP SCREEN":DATA" ":DATA"DEFINED VARIABLES MAY BE ADDED TO YOUR DATA BASE AND SELECTED FOR":DATA"TREATMENT AS ANY OTHER VARIABLE. ":DATA" ":DATA"OPERATORS SUPPORTED ARE: +,-,*,/,^,LOG":DATA"  
  882. 9650  DATA"THE DEFINITION MUST BE IN THE FORM ":DATA"           XNUMBER  OPERATOR   CONSTANT/XNUMBER":DATA"THUS X1+4 IS A LEGAL DEFINITION, AS IS X4*X3, BUT X1+X2+4 IS NOT.":DATA" 
  883. 9660  DATA"IT IS BEST TO ADD THESE DEFINITIONS BEFORE CASE DATA HAS BEEN ENTERED,":DATA"BUT, THEY MAY BE ADDED AT ANY TIME, AND FILE REWRITING WILL OCCUR.":DATA"
  884. 9670  DATA"PRINT HELP SCREEN":DATA"  ":DATA"THE PRINT OPTION FROM THE MAIN MENU WILL PRINT ALL CASES WHICH":DATA"SATISFY THE SUBSET DEFINITIONS SPECIFIED.":DATA"  ":DATA"IF SUBSETS OR DERIVED VARIABLES HAVE BEEN DEFINED OR DATA HAS BEEN
  885. 9680  DATA"ENTERED, SELECTING THIS OPTION WILL TRIGGER DISK FILE REWRITE. ":DATA"PROCESSING TIME WILL DEPEND ON THE SIZE OF YOUR DATABASE, AND":DATACOULD TAKE SEVERAL MOMENTS."":DATA"  
  886. 9690  DATA"TO PRINT ANY SCREEN, PRESS <SHIFT> AND (PRTSC> AT THE SAME TIME.":DATA"
  887. 9700  DATA"EXIT HELP SCREEN":DATA"  ":DATA "EXITING THE PROGRAM WILL TRIGGER ANY":DATA "DISK WRITING WHICH NEEDS TO TAKE PLACE.":DATA " ":DATA "THE PROGRAM WILL EXIT TO BASIC WILL ALL FUNCTIONS RESET.":DATA ""
  888. 9710  GOSUB 3510 
  889. 9715  PRINT "(L)ABELS   (D)EFS   (S)UBS   (V)ALUES   (U)P   DO(W)N   (R)ETURN";
  890. 9720   CMD$ = "LDSVUWR"+CR$
  891. 9740     IF FF < 1 OR FF > 3 THEN FF = 1 : VFLAG = 0 : F1 = 0
  892. 9750  GOSUB 2340
  893. 9760   IF CMD>6 OR FCMD<>0 THEN FCMD=0:RETURN
  894. 9800    ON CMD GOSUB 9910,9980,10050,9820,9850,9880
  895. 9810     GOTO 9710
  896. 9820  VFLAG = 3 - VFLAG
  897. 9830   ON ( FF + VFLAG ) GOSUB 9910,9980,10050,10120,10180,10240
  898. 9840    RETURN
  899. 9850  F1 = F1 - FW
  900. 9860   GOSUB 3780
  901. 9870    RETURN
  902. 9880  F1 = F1 + FW
  903. 9890   GOSUB 3780
  904. 9900    RETURN
  905. 9910  FF = 1
  906. 9920   F0 = BVARS
  907. 9930    F2 = F0 + NVARS
  908. 9940     F0 = F0 + 1
  909. 9950      F$ = "x"
  910. 9960       GOSUB 3780
  911. 9970        RETURN
  912. 9980  FF = 2
  913. 9990   F0 = BDEFS
  914. 10000    F2 = F0 + NDEFS
  915. 10010     F0 = F0 + 1
  916. 10020      F$ = "d"
  917. 10030       GOSUB 3780
  918. 10040        RETURN
  919. 10050  FF = 3
  920. 10060   F0 = BSUBS
  921. 10070    F2 = F0 + NSUBS
  922. 10080     F0 = F0 + 1
  923. 10090      F$ = "s"
  924. 10100       GOSUB 3780
  925. 10110        RETURN
  926. 10120  F0 = BVARS + MAXLBLS
  927. 10130   F2 = F0 + NVARS
  928. 10140    F0 = F0 + 1
  929. 10150     F$ = "x"
  930. 10160      GOSUB 3780
  931. 10170       RETURN
  932. 10180  F0 = BDEFS + MAXLBLS
  933. 10190   F2 = F0 + NDEFS
  934. 10200    F0 = F0 + 1
  935. 10210     F$ = "d"
  936. 10220      GOSUB 3780
  937. 10230       RETURN
  938. 10240  F0 = BSUBS + MAXLBLS
  939. 10250   F2 = F0 + NSUBS
  940. 10260    F0 = F0 + 1
  941. 10270     F$ = "s"
  942. 10280      GOSUB 3780
  943. 10290       RETURN
  944. 10300  F0 = BPTR + 1
  945. 10310   F1 = FPTR - BPTR
  946. 10320    F2 = NPTR
  947. 10330     F$ = FTYP$
  948. 10340      GOSUB 3780
  949. 10350       RETURN
  950. 10360  GOSUB 3510
  951. 10370   PRINT LIN$" EVALUATES TO ";
  952. 10380    CMD = 1
  953. 10390     GOSUB 11030
  954. 10400      ON OP GOSUB 10450,10500,10530,10560,10590,10610,10630,10650,10680,10710,10750,10780,10810
  955. 10410       IF CMD < > 0 THEN PRINT STR$( V ); : RETURN
  956. 10420  PRINT PROMPT$;
  957. 10440    RETURN
  958. 10450  V = 1
  959. 10460   FOR J = BVALS + 1 TO BVALS + NVARS
  960. 10470    IF VAL( W$( J ) ) = 0 THEN V = 0 : J = BVALS + NVARS
  961. 10480  NEXT
  962. 10490   RETURN
  963. 10500  V = 0
  964. 10510   IF ARG1 = ARG2 THEN V = 1
  965. 10520  RETURN
  966. 10530  V = 0
  967. 10540   IF ARG1 < ARG2 THEN V = 1
  968. 10550  RETURN
  969. 10560  V = 0
  970. 10570   IF ARG1 > ARG2 THEN V = 1
  971. 10580  RETURN
  972. 10590  V = ARG1 + ARG2
  973. 10600   RETURN
  974. 10610  V = ARG1 - ARG2
  975. 10620   RETURN
  976. 10630  V = ARG1 * ARG2
  977. 10640   RETURN
  978. 10650  IF ARG2 = 0 THEN V = 0 : PROMPT$ = "DIVISION BY 0" : CMD = 0 : RETURN
  979. 10660  V = ARG1 / ARG2
  980. 10670   RETURN
  981. 10680  IF ARG1 < = 0 THEN V = 0 : PROMPT$ = "LOG ARGUMENT ERROR" : CMD = 0 : RETURN
  982. 10690  V = LOG( ARG1 )
  983. 10700   RETURN
  984. 10710  IF ARG1 = 0 THEN V = 1 : RETURN
  985. 10720  IF ARG2 * LOG( ABS( ARG1 ) ) > 37 THEN V = 0 : PROMPT$ = "OVERFLOW ERROR" : CMD = 0 : RETURN
  986. 10730  V = ARG1 ^ ARG2
  987. 10740   RETURN
  988. 10750  V = 0
  989. 10760   IF ARG1 > = ARG2 THEN V = 1
  990. 10770  RETURN
  991. 10780  V = 0
  992. 10790   IF ARG1 < = ARG2 THEN V = 1
  993. 10800  RETURN
  994. 10810  V = 0
  995. 10820   IF ARG1 < > ARG2 THEN V = 1
  996. 10830  RETURN
  997. 10840  ON FTYP GOSUB 10860,10880,10930,10980
  998. 10850   RETURN
  999. 10860  W$ = LIN$
  1000. 10870   RETURN
  1001. 10880  GOSUB 11030
  1002. 10890   IF OP < 1 OR ( OP > = 5 AND OP < = 10 ) THEN RETURN
  1003. 10900  PROMPT$ = "NOT A VALID DATA DEFINITION"
  1004. 10910   CMD = 0
  1005. 10920    RETURN
  1006. 10930  GOSUB 11030
  1007. 10940   IF OP < 5 OR OP > 10 THEN RETURN
  1008. 10950  PROMPT$ = "NOT A VALID SUBSET DEFINITION"
  1009. 10960   CMD = 0
  1010. 10970    RETURN
  1011. 10980  J = INT( VAL( LIN$ ) )
  1012. 10990   IF J=VAL(LIN$) AND ABS(J)<=9999 THEN W$=STR$(J):RETURN
  1013. 11000  CMD = 0
  1014. 11010   PROMPT$ = "BAD DATA VALUE"
  1015. 11020    RETURN
  1016. 11030  W$ = ""
  1017. 11040   GOSUB 11100
  1018. 11050    IF CMD = 0 OR OP = 0 THEN RETURN
  1019. 11060  IF OP = 1 THEN W$ = "REJIF0" : RETURN
  1020. 11070  IF OP = 9 THEN W$ = "LOG " : GOSUB 11490 : RETURN
  1021. 11080  GOSUB 11360
  1022. 11090   RETURN
  1023. 11100  G2 = LEN( LIN$ ) - 1
  1024. 11110   OP = 0
  1025. 11120    FOR JJ = 1 TO G2
  1026. 11130     X$ = MID$( LIN$,JJ,1 )
  1027. 11140      OPTR = JJ
  1028. 11150       GOSUB 11200
  1029. 11160        IF OP > 0 THEN W$ = X$ : JJ = G2
  1030. 11170  NEXT
  1031. 11180   IF OP = 0 THEN CMD = 0 : PROMPT$ = "DON'T RECOGNIZE FUNCTION"
  1032. 11190  RETURN
  1033. 11200  GOSUB 2660
  1034. 11210   OP = INSTR( "R=<>+-*/L^",X$ )
  1035. 11220    IF OP < 2 OR OP > 6 THEN RETURN
  1036. 11230  IF OP = 5 OR OP = 6 THEN 11330
  1037. 11240  Y$ = MID$( LIN$,OPTR + 1,1 )
  1038. 11250   K = INSTR( ">= => <= =< <>",X$ + Y$ )
  1039. 11260    IF K = 0 THEN RETURN
  1040. 11270  OPTR = OPTR + 1
  1041. 11280   X$ = X$ + Y$
  1042. 11290    IF K = 1 OR K = 4 THEN OP = 11 : RETURN
  1043. 11300  IF K = 7 OR K = 10 THEN OP = 12 : RETURN
  1044. 11310  IF K = 13 THEN OP = 13
  1045. 11320  RETURN
  1046. 11330  Y$ = MID$( LIN$,OPTR + 1,1 )
  1047. 11340   IF INSTR( "0123456789",Y$ ) THEN OP = 0
  1048. 11350  RETURN
  1049. 11360  G1 = 1
  1050. 11370   G2 = OPTR - 1
  1051. 11380    GOSUB 11560
  1052. 11390     IF CMD = 0 THEN RETURN
  1053. 11400  W$ = ARG$ + W$
  1054. 11410   ARG1 = ARG
  1055. 11420    G1 = OPTR + 1
  1056. 11430     G2 = LEN( LIN$ )
  1057. 11440      GOSUB 11560
  1058. 11450       IF CMD = 0 THEN RETURN
  1059. 11460  W$ = W$ + ARG$
  1060. 11470   ARG2 = ARG
  1061. 11480    RETURN
  1062. 11490  G1 = OPTR + 1
  1063. 11500   G2 = LEN( LIN$ )
  1064. 11510    GOSUB 11560
  1065. 11520     IF CMD = 0 THEN RETURN
  1066. 11530  W$ = W$ + ARG$
  1067. 11540   ARG1 = ARG
  1068. 11550    RETURN
  1069. 11560  ARG$ = ""
  1070. 11570   ARG = 0
  1071. 11580    FOR ARGPTR = G1 TO G2
  1072. 11590     X$ = MID$( LIN$,ARGPTR,1 )
  1073. 11600      GOSUB 2710
  1074. 11610       K = INSTR( "XD+-0123456789",X$ )
  1075. 11620        IF K > 0 THEN GOSUB 11660 : ARGPTR = G2
  1076. 11630  NEXT
  1077. 11640   IF K = 0 THEN CMD = 0 : PROMPT$ = "BAD ARGUMENT"
  1078. 11650  RETURN
  1079. 11660  IF K < 3 AND ARGPTR = G2 THEN K = 0 : RETURN
  1080. 11670  IF K < 3 THEN ARGPTR = ARGPTR + 1
  1081. 11680  U = VAL( MID$( LIN$,ARGPTR ) )
  1082. 11690   IF K > 2 THEN ARG$ = STR$( U ) : ARG = U : RETURN
  1083. 11700  L = NVARS
  1084. 11710   IF K = 2 THEN L = NDEFS
  1085. 11720  IF U < 1 OR U > L THEN K = 0 : RETURN
  1086. 11730  ARG$ = X$ + MID$( STR$( U ),2 )
  1087. 11740   IF K = 1 THEN ARG = VAL( W$( BVALS + U ) ) : RETURN
  1088. 11750  IF K = 1 THEN ARG = VAL( W$( BVALS + U ) ) : RETURN
  1089. 11760  ARG = VAL( W$( BDEFS + MAXLBLS + U ) )
  1090. 11770   RETURN
  1091. 11780  IF FILSPEC$ = "" THEN GOSUB 8910 : RETURN
  1092. 11785  ON ERROR GOTO 13000
  1093. 11790  MD = PRNT
  1094. 11800   X$ = "PRINT CASES"
  1095. 11810    GOSUB 2760
  1096. 11815     GOSUB 3650
  1097. 11820     GOSUB 5730
  1098. 11830      GOSUB 3510 : PRINT "PRINT ALL CASES";
  1099. 11840        GOSUB 2410
  1100. 11850         IF X$ = "Y" THEN GOSUB 11930 : RETURN
  1101. 11860  IF FCMD = ESC THEN 11780
  1102. 11870  IF FCMD =QRET THEN RETURN 
  1103. 11875  IF FCMD THEN 11790
  1104. 11880  GOSUB 12000
  1105. 11890  GOSUB 9150
  1106. 11900   IF FCMD = 0 THEN GOSUB 12270 : GOTO 11890
  1107. 11910  GOSUB 12500
  1108. 11920   RETURN
  1109. 11930  GOSUB 12000
  1110. 11940   FOR CCASE = 1 TO NCASE
  1111. 11950    GOSUB 5190
  1112. 11960     GOSUB 12270
  1113. 11970      NEXT
  1114. 11980       GOSUB 12500
  1115. 11990        RETURN
  1116. 12000  LPRINT
  1117. 12010   LPRINT FILNAM$;
  1118. 12020    IF FILDESC$ < > "" THEN LPRINT ": "FILDESC$;
  1119. 12030  LPRINT "  CASE FILE LISTING"
  1120. 12040   LPRINT
  1121. 12050    X$ = SPACE$( 7 )
  1122. 12060     LSET X$ = "CASE#"
  1123. 12070      LPRINT X$;
  1124. 12080       K = 1
  1125. 12090        L = BVARS
  1126. 12100         FOR J = 1 TO NVARS
  1127. 12110          GOSUB 12230
  1128. 12120           NEXT
  1129. 12130            L = BDEFS
  1130. 12140             FOR J = 1 TO NDEFS
  1131. 12150              GOSUB 12230
  1132. 12160               NEXT
  1133. 12170                L = BSUBS
  1134. 12180                 FOR J = 1 TO NSUBS
  1135. 12190                  GOSUB 12230
  1136. 12200                   NEXT
  1137. 12210                    IF K MOD 6 < > 1 THEN LPRINT
  1138. 12220  RETURN
  1139. 12230  LPRINT W$( L + J );
  1140. 12240   K = K + 1
  1141. 12250    IF K MOD 6 = 1 THEN LPRINT  : LPRINT SPACE$( 7 );
  1142. 12260  RETURN
  1143. 12270  X$ = SPACE$( 7 )
  1144. 12280   LSET X$ = STR$( CCASE )
  1145. 12290    LPRINT
  1146. 12300     LPRINT X$;
  1147. 12310      K = 1
  1148. 12320       L = BVARS
  1149. 12330        FOR J = 1 TO NVARS
  1150. 12340         GOSUB 12460
  1151. 12350          NEXT
  1152. 12360           L = BDEFS
  1153. 12370            FOR J = 1 TO NDEFS
  1154. 12380             GOSUB 12460
  1155. 12390              NEXT
  1156. 12400               L = BSUBS
  1157. 12410                FOR J = 1 TO NSUBS
  1158. 12420                 GOSUB 12460
  1159. 12430                  NEXT
  1160. 12440                   IF K MOD 6 < > 1 THEN LPRINT
  1161. 12450  RETURN
  1162. 12460  LPRINT W$( L + MAXLBLS + J );
  1163. 12470   K = K + 1
  1164. 12480    IF K MOD 6 = 1 THEN LPRINT  : LPRINT SPACE$( 7 );
  1165. 12490  RETURN
  1166. 12500  LPRINT
  1167. 12510   LPRINT STR$( NCASE )" CASES IN FILE"
  1168. 12520    RETURN
  1169. 12530  '
  1170. 13000  GOSUB 3510
  1171. 13010   IF ERR<>27 THEN 6190
  1172. 13020    PRINT "PRINTER NOT READY";
  1173. 13030     GOSUB 2460
  1174. 13040      RESUME
  1175. 13050  '
  1176. 19000  DATA"HELP SCREEN FOR THE DIF TRANSLATION"
  1177. 19010  DATA"  "
  1178. 19011  DATA "In order to translate a DIF file to STL"
  1179. 19012  DATA "format, you must have created a spread-"
  1180. 19013  DATA "sheet which has no blanks.":DATA "  "
  1181. 19014  DATA "If you have the variable labels along the left"
  1182. 19015  DATA "edge of the sheet, save the sheet by ROW."
  1183. 19016  DATA "If the variable labels go from left to right"
  1184. 19017  DATA "along the sheet, save the sheet by COLUMN."
  1185. 19040  DATA ""
  1186. 19050  '
  1187. 20000  X$="TRANSLATE *.DIF TO *.STL"
  1188. 20010   GOSUB 2760
  1189. 20020    MD=XLAT
  1190. 20030  GOSUB 3650
  1191. 20031     IF FILSPEC$<>"" THEN GOSUB 4520
  1192. 20032  '
  1193. 20036  GOSUB 6450:IF FCMD=HELP OR FCMD=VYEW THEN GOTO 20036
  1194. 20037  IF FCMD THEN RETURN
  1195. 20038  GOSUB 3650
  1196. 20039  LOCATE FP+2,FQ+3
  1197. 20040  PRINT "MAXIMUM NUMBER OF VARIABLES:";BUFSIZ
  1198. 20041  '
  1199. 20045  GOSUB 3510
  1200. 20050  PRINT "ENTER THE NAME OF YOUR *.DIF FILE";
  1201. 20060  MAXLIN = 14
  1202. 20070  GOSUB 2510
  1203. 20080  IF FCMD=QRET THEN RETURN
  1204. 20090  IF FCMD=HELP OR FCMD=VYEW THEN GOTO 20038
  1205. 20091  IF FCMD=REDO THEN GOTO 20036
  1206. 20092  IF LIN$="" THEN GOTO 20045
  1207. 20093  '
  1208. 20100  J=INSTR(LIN$,".")-1
  1209. 20110  IF J<1 THEN J=LEN(LIN$)
  1210. 20120  FILNAM$=LEFT$(LIN$,J)
  1211. 20130  DIF$=LIN$+".DIF"
  1212. 20160  '
  1213. 20200  GOSUB 8750:IF FCMD=QRET THEN RETURN
  1214. 20205  IF FCMD THEN GOTO 20038
  1215. 20210  IF FILDRV$<>"" THEN DIF$=FILDRV$+":"+DIF$
  1216. 20220  LOCATE FP+4,FQ+3
  1217. 20230  PRINT "NAME OF INPUT FILE: ";DIF$
  1218. 20231  '
  1219. 20232  GOSUB 3510
  1220. 20233  PRINT "ENTER DRIVE TO USE FOR OUTPUT FILES";
  1221. 20234  GOSUB 8760
  1222. 20240  IF FCMD=QRET THEN RETURN
  1223. 20241  IF FCMD THEN GOTO 20038
  1224. 20250  IF FILDRV$<>"" THEN FILSPEC$=FILDRV$+":"+FILNAM$ ELSE FILSPEC$=FILNAM$
  1225. 20260  LOCATE FP+6,FQ+3
  1226. 20270  PRINT "OUTPUT FILE NAMES WILL BE ";FILSPEC$;".STL, ";FILSPEC$;".DAT"
  1227. 20280  '
  1228. 20300  GOSUB 8850:IF FCMD=QRET THEN RETURN
  1229. 20301  IF FCMD THEN 20038
  1230. 20310  LOCATE FP+8,FQ+3
  1231. 20320  PRINT "FILE DESCRIPTION:";FILDESC$
  1232. 20340  '
  1233. 20960  GOSUB 3510
  1234. 20970  PRINT "OK TO PROCEED";
  1235. 20980  GOSUB 2410
  1236. 20990  IF X$<>"Y" THEN 20036
  1237. 20997  '
  1238. 21000  GOSUB 3510
  1239. 21010  PRINT "TRANSLATING TO .STL FORMAT...";
  1240. 21040  '
  1241. 22010  ON ERROR GOTO 22520                                   'DIF_ERROR1
  1242. 22020  OPEN "I",#3,DIF$
  1243. 22030  GOSUB 22420                                            'INDAT
  1244. 22040  IF X$<>"TABLE" THEN GOTO 22560                         'DIF_ERROR2
  1245. 22050  INPUT#3,X$<UNK! {0009}>
  1246. 22060  GOSUB 22420                                            'INDAT
  1247. 22070  J=VAL(Z$)
  1248. 22080  INPUT#3,X$<UNK! {0009}>
  1249. 22090  GOSUB 22420                                            'INDAT
  1250. 22100  K=VAL(Z$)
  1251. 22110  INPUT#3,X$<UNK! {0009}>
  1252. 22120  GOSUB 22420                                            'INDAT
  1253. 22130  INPUT#3,X$<UNK! {0009}>
  1254. 22140  NVARS=J
  1255. 22150  NCASE=K-1
  1256. 22160  NDEFS=0
  1257. 22170  NSUBS=0
  1258. 22180  GOSUB 22460<UNK! {0009}>                                     'INBOT
  1259. 22190  FOR J = BVARS+1 TO BVARS+NVARS
  1260. 22200  GOSUB 22420                                            'INDAT
  1261. 22210  LSET W$(J)=Z$
  1262. 22220  NEXT
  1263. 22230  F1=1:GOSUB 9910
  1264. 22240  GOSUB 3510
  1265. 22250  PRINT "OK TO CONTINUE";
  1266. 22260  GOSUB 2410
  1267. 22270  IF X$<>"Y" THEN GOTO 22400                             'DIF_RESUME
  1268. 22280  GOSUB 4550
  1269. 22290  GOSUB 4860
  1270. 22300  FOR CCASE = 1 TO NCASE
  1271. 22310  GOSUB 22460                                            'INBOT
  1272. 22320  FOR J = BVALS+1 TO BVALS+NVARS
  1273. 22330  GOSUB 22420                                            'INDAT
  1274. 22340  LSET W$(J)=Y$
  1275. 22350  NEXT
  1276. 22360  GOSUB 10120
  1277. 22370  GOSUB 4910
  1278. 22380  NEXT
  1279. 22390  CLOSE
  1280. 22395  GOSUB 4200
  1281. 22400  ON ERROR GOTO 6190                                    'DIF_RESUME
  1282. 22410  RETURN
  1283. 22420  INPUT#3,X$                                            'INDAT
  1284. 22430  INPUT#3,Y$
  1285. 22440  INPUT#3,Z$
  1286. 22450  RETURN
  1287. 22460  GOSUB 22420                                            'INBOT;INDAT
  1288. 22470  IF Z$="BOT" THEN RETURN
  1289. 22480  GOSUB 3510
  1290. 22490  PRINT "BAD TUPLE";
  1291. 22500  GOSUB 2460
  1292. 22510  GOTO 22400                                             'DIF_RESUME
  1293. 22520  GOSUB 3510                                            'DIF_ERROR1
  1294. 22530  PRINT "CAN'T OPEN ";DIF$;
  1295. 22540  GOSUB 2460
  1296. 22550  RESUME 22400                                           'DIF_RESUME
  1297. 22560  GOSUB 3510                                            'DIF_ERROR2
  1298. 22570  PRINT "NOT A DIF FORMAT FILE";
  1299. 22580  GOSUB 2460
  1300. 22590  GOTO 22400                                             'DIF_RESUME
  1301. 22600  STOP                                                  'NULL LABEL
  1302.